home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0055_Compute the work week.pas < prev   
Pascal/Delphi Source File  |  1995-02-28  |  1KB  |  56 lines
  1. {A function and test program for computing the work week under one common
  2.  definition.
  3.  
  4.  Written 94/10/05, Kim Kokkonen, TurboPower Software
  5. }
  6.  
  7. uses
  8.   opdate; {tpdate ok too}
  9.  
  10. function WeekOfYear(Julian : Date) : Integer;
  11.   {-Return the week-of-year from a julian date. As defined here, the week
  12.     always starts on a Sunday. Week 1 starts on the first Sunday of the
  13.     year. Returns 0 for days earlier than that, and -1 for invalid dates.}
  14.  
  15. var
  16.   Day, Month, Year : Integer;
  17.   FirstJulian : Date;
  18.   FirstDay : DayType;
  19. begin
  20.   {Exit for invalid dates}
  21.   if (Julian < MinDate) or (Julian > MaxDate) then begin
  22.     WeekOfYear := -1;
  23.     exit;
  24.   end;
  25.  
  26.   {Compute FirstJulian, the julian date for the first Sunday in the year}
  27.   DateToDMY(Julian, Day, Month, Year);
  28.   FirstJulian := DMYToDate(1, 1, Year);
  29.   FirstDay := DayOfWeek(FirstJulian);
  30.   if FirstDay <> Sunday then
  31.     inc(FirstJulian, 7-Ord(FirstDay));
  32.  
  33.   if Julian < FirstJulian then
  34.     WeekOfYear := 0
  35.   else
  36.     WeekOfYear := (Julian-FirstJulian+7) div 7;
  37. end;
  38.  
  39. var
  40.   s : string;
  41.   d : date;
  42.  
  43. begin
  44.   repeat
  45.     Write('Enter date (dd/mm/yy): ');
  46.     ReadLn(s);
  47.     if s = '' then
  48.       halt;
  49.     if (Length(s) = 8) and (s[3] = '/') and (s[6] = '/') then begin
  50.       d := DateStringToDate('dd/mm/yy', s);
  51.       WriteLn('Week: ', WeekOfYear(d));
  52.     end else
  53.       WriteLn('Invalid date format');
  54.   until False;
  55. end.
  56.